00100	SUBR(CRE)------------------------------------------------------
00200	BEGIN CRE;(Q1,Q2) - MAKE CRE STRUCTURE - BGB - 6 DEC 1972.
00300	
00400	;BIT POSITIONS OF THE ARGUMENTS Q1 & Q2 ENABLE INTENSITY CUTS.
00500		LAC 1,ARG2↔DAC 1,Q0
00600		LAC 1,ARG1↔ANDCMI 1,377↔DAC 1,Q1
00700		SETZM CUT#
00800	
00900		SETQ IMAGE,{MKIMAG,FILM}
01000		CALL(SEGTV)
01100	
01200	;FIND AN INTENSITY CONTOUR ENABLE BIT.
01300	L0:	LAC 0,Q0↔LAC 1,Q1
01400	L1:	AOS 2,CUT↔LSHC 0,1↔JUMPL 0,L2
01500		CAMN 0,1↔JUMPE 0,L5↔GO L1
01600	
01700	;THRESHOLD THE TVBUF
01800	L2:	DAC 0,Q0↔DAC 1,Q1
01900		CALL(THRESH,CUT)
02000		CALL(PACXOR)
02100	
02200	;MAKE LEVEL NODE WITH A RING OF POLYGON NODES.
02300		SETQ(LEVEL,{MKLEVL,IMAGE,CUT})
02400	L3:	SETQ(POLYGON,{MKPGON,LEVEL})
02500		JUMPN 1,L3↔LAC 1,LEVEL↔SON 1,1↔JUMPE 1,L0
02600	
02700	;LEVEL OPERATIONS.
02800	L4:
02900		CALL(BABYKILLER,LEVEL)
03000		CALL(STADPY)
03100		GO L0
03200	
03300	;IMAGE OPERATIONS.
03400	L5:	SETZ↔SKIPE FLGKRK↔CORE2↔JFCL
03500		LAC 1,IMAGE↔POP2J
03600	
03700		DECLARE{Q0,Q1}
03800	BEND;1/10/73------------------------------------------------------
03900		DECLARE{IMAGE,LEVEL,POLYGON}
     

00100	SUBR(MKIMAG)FILM--------------------------------------------------
00200	BEGIN MKIMAG; MAKE IMAGE NODE - BGB - 10 JANUARY 1973.
00300		SETQ(IMAGE,{MAKE,[IBIT+IMGREL]})
00400		CALL(RINGIN,IMAGE,FILM)
00500		LAC 1,IMAGE↔LAC 2,FILM
00600		SON. 1,2↔DAD. 2,1
00700		LIPI 1,(1)↔DAC 1,3(1)↔DAC 1,4(1)↔DAC 1,5(1)    ;FEV-RINGS.
00800		POP1J
00900	BEND;1/10/73------------------------------------------------------
01000	
01100	SUBR(MKLEVL)IMAGE,CUT---------------------------------------------
01200	BEGIN MKLEVL; MAKE LEVEL NODE - BGB - 10 JANUARY 1973.
01300		SETQ(LEVEL,{MAKE,[LBIT+LVLREL]})
01400		CALL(RINGIN,LEVEL,IMAGE)
01500		LAC 1,LEVEL↔LAC 2,IMAGE
01600		SETO↔NCNT. 0,1
01700		SKIPGE↔SON. 1,2↔DAD. 2,1
01800		POP2J
01900	BEND;1/10/73------------------------------------------------------